home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1996 #15 / Monster Media Number 15 (Monster Media)(July 1996).ISO / os2 / lxlt113.zip / SOURCES / EXE386.PAS < prev    next >
Pascal/Delphi Source File  |  1996-06-03  |  69KB  |  1,888 lines
  1. (****************************************************************************)
  2. (*  Title:       exe386.pas                                                 *)
  3. (*  Description: Data structure definitions for the OS/2 executable file    *)
  4. (*               format (flat model); additionaly contains a handy object   *)
  5. (*               for LX files manipulations (tLX).                          *)
  6. (****************************************************************************)
  7. (*               Copyright (c) IBM Corporation 1987, 1992                   *)
  8. (*                Copyright (c) Microsoft Corp 1988, 1991                   *)
  9. (*            C->Pascal conversion (c) FRIENDS software, 1996               *)
  10. (*          tLX object implementation (c) FRIENDS software, 1996            *)
  11. (****************************************************************************)
  12. {$AlignCode-,AlignData-,AlignRec-,G3+,Speed-,Frame-}
  13. Unit exe386;
  14.  
  15. Interface uses use32, miscUtil;
  16.  
  17. const
  18.      lxfMagic        = $584C;             { New magic number  "LX" }
  19.      exeMagic1       = $5A4D;             { EXE file magic number "MZ" }
  20.      exeMagic2       = $4D5A;             { EXE file magic number "ZM" }
  21.      lxResBytes      = 24;                { bytes reserved }
  22.      lxLEBO          = $00;               { Little Endian Byte Order }
  23.      lxBEBO          = $01;               { Big Endian Byte Order }
  24.      lxLEWO          = $00;               { Little Endian Word Order }
  25.      lxBEWO          = $01;               { Big Endian Word Order }
  26.      lxLevel         = 0;                 { 32-bit EXE format level }
  27.      lxCPU286        = $01;               { Intel 80286 or upwardly compatibile }
  28.      lxCPU386        = $02;               { Intel 80386 or upwardly compatibile }
  29.      lxCPU486        = $03;               { Intel 80486 or upwardly compatibile }
  30.      lxCPUP5         = $04;               { Intel P5 or upwardly compatibile }
  31.  
  32. type pLXheader = ^tLXheader;
  33.      tLXheader = record                   { New 32-bit .EXE header }
  34.       lxMagic      : SmallWord;           { magic number LXmagic }
  35.       lxBOrder     : Byte;                { The byte ordering for the .EXE }
  36.       lxWOrder     : Byte;                { The word ordering for the .EXE }
  37.       lxLevel      : Longint;             { The EXE format level for now = 0 }
  38.       lxCpu        : SmallWord;           { The CPU type }
  39.       lxOS         : SmallWord;           { The OS type }
  40.       lxVer        : Longint;             { Module version }
  41.       lxMflags     : Longint;             { Module flags }
  42.       lxMpages     : Longint;             { Module # pages }
  43.       lxStartObj   : Longint;             { Object # for instruction pointer }
  44.       lxEIP        : Longint;             { Extended instruction pointer }
  45.       lxStackObj   : Longint;             { Object # for stack pointer }
  46.       lxESP        : Longint;             { Extended stack pointer }
  47.       lxPageSize   : Longint;             { .EXE page size }
  48.       lxPageShift  : Longint;             { Page alignment shift in .EXE }
  49.       lxFixupSize  : Longint;             { Fixup section size }
  50.       lxFixupSum   : Longint;             { Fixup section checksum }
  51.       lxLdrSize    : Longint;             { Loader section size }
  52.       lxLdrSum     : Longint;             { Loader section checksum }
  53.       lxObjTabOfs  : Longint;             { Object table offset }
  54.       lxObjCnt     : Longint;             { Number of objects in module }
  55.       lxObjMapOfs  : Longint;             { Object page map offset }
  56.       lxIterMapOfs : Longint;             { Object iterated data map offset }
  57.       lxRsrcTabOfs : Longint;             { Offset of Resource Table }
  58.       lxRsrcCnt    : Longint;             { Number of resource entries }
  59.       lxResTabOfs  : Longint;             { Offset of resident name table }
  60.       lxEntTabOfs  : Longint;             { Offset of Entry Table }
  61.       lxDirTabOfs  : Longint;             { Offset of Module Directive Table }
  62.       lxDirCnt     : Longint;             { Number of module directives }
  63.       lxFPageTabOfs: Longint;             { Offset of Fixup Page Table }
  64.       lxFRecTabOfs : Longint;             { Offset of Fixup Record Table }
  65.       lxImpModOfs  : Longint;             { Offset of Import Module Name Table }
  66.       lxImpModCnt  : Longint;             { Number of entries in Import Module Name Table }
  67.       lxImpProcOfs : Longint;             { Offset of Import Procedure Name Table }
  68.       lxPageSumOfs : Longint;             { Offset of Per-Page Checksum Table }
  69.       lxDataPageOfs: Longint;             { Offset of Enumerated Data Pages }
  70.       lxPreload    : Longint;             { Number of preload pages }
  71.       lxNResTabOfs : Longint;             { Offset of Non-resident Names Table }
  72.       lxCbNResTabOfs:Longint;             { Size of Non-resident Name Table }
  73.       lxNResSum    : Longint;             { Non-resident Name Table Checksum }
  74.       lxAutoData   : Longint;             { Object # for automatic data object }
  75.       lxDebugInfoOfs:Longint;             { Offset of the debugging information }
  76.                                           { RELATIVE TO START OF EXE FILE}
  77.       lxDebugLen   : Longint;             { The length of the debugging info. in bytes }
  78.       lxInstPreload: Longint;             { Number of instance pages in preload section of .EXE file }
  79.       lxInstDemand : Longint;             { Number of instance pages in demand load section of .EXE file }
  80.       lxHeapSize   : Longint;             { Size of heap - for 16-bit apps }
  81.       lxReserved   : array[1..lxResBytes] of Byte;
  82.      end;                                 { Pad structure to 196 bytes }
  83.  
  84. { Format of lxMFlags:                                                        }
  85. {                                                                            }
  86. { Low word has the following format:                                         }
  87. {                                                                            }
  88. { 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 0  - bit no                            }
  89. {  |     |          | |     | |   |                                          }
  90. {  |     |          | |     | |   +------- Per-Process Library Initialization}
  91. {  |     |          | |     | +----------- No Internal Fixups for Module in .EXE}
  92. {  |     |          | |     +------------- No External Fixups for Module in .EXE}
  93. {  |     |          | +------------------- Incompatible with PM Windowing    }
  94. {  |     |          +--------------------- Compatible with PM Windowing      }
  95. {  |     |                                 Uses PM Windowing API             }
  96. {  |     +-------------------------------- Module not Loadable               }
  97. {  +-------------------------------------- Library Module                    }
  98. const
  99.      lxNoLoad       = $00002000;          { Module not Loadable }
  100.      lxNoTP         = $00008000;          { Library Module - used as NEnoTP }
  101.      lxNoPMwin      = $00000100;          { Incompatible with PM Windowing }
  102.      lxPMwin        = $00000200;          { Compatible with PM Windowing }
  103.      lxPMapi        = $00000300;          { Uses PM Windowing API }
  104.      lxNoIntFix     = $00000010;          { NO Internal Fixups in .EXE }
  105.      lxNoExtFix     = $00000020;          { NO External Fixups in .EXE }
  106.      lxLibInit      = $00000004;          { Per-Process Library Initialization }
  107.      lxLibTerm      = $40000000;          { Per-Process Library Termination }
  108.      lxAppMask      = $00000700;          { Application Type Mask }
  109.  
  110. { Format of lxMFlags                                                       }
  111. {                                                                          }
  112. { High word has the following format:                                      }
  113. { 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 0  - bit no                          }
  114. {                                   | |                                    }
  115. {                                   | +--- Protected memory library module }
  116. {                                   +----- Device driver                   }
  117. const
  118.      lxEXE          = $00000000;         { .EXE module                     }
  119.      lxDLL          = $00008000;         { Dynamic Link library            }
  120.      lxPMDLL        = $00018000;         { Protected memory library module }
  121.      lxPDD          = $00020000;         { Physical device driver          }
  122.      lxVDD          = $00028000;         { Virtual device driver           }
  123.      lxModType      = $00038000;         { Module type mask                }
  124.  
  125. { RELOCATION DEFINITIONS - RUN-TIME FIXUPS }
  126. type pOffset = ^tOffset;
  127.      tOffset = record case byte of
  128.       0 : (offset16 : SmallWord);
  129.       1 : (offset32 : Longint);
  130.      end;                                 { 16-bit or 32-bit offset }
  131.  
  132. { ET + lxrrlc - Relocation item }
  133.      pRelocation = ^tRelocation;
  134.      tRelocation = record                 { Relocation item }
  135.       nr_SType     : Byte;                { Source type - field shared with new_rlc }
  136.       nr_Flags     : Byte;                { Flag byte - field shared with new_rlc }
  137.       rSoff        : SmallWord;           { Source offset }
  138.       rObjMod      : SmallWord;           { Target object number or Module ordinal }
  139.       rTarget      : record case Byte of
  140.        0 : (intRef : tOffset);
  141.        1 : (extRef : record case byte of
  142.              0 : (Proc : tOffset);        { Procedure name offset }
  143.              1 : (Ord  : Longint);        { Procedure ordinal }
  144.             end);
  145.        2 : (addFix : record case byte of
  146.              0 : (entry  : SmallWord);
  147.              1 : (AddVal : tOffset);
  148.             end);
  149.       end;
  150.       rSrcCount : SmallWord;              { Number of chained fixup records }
  151.       rChain    : SmallWord;              { Chain head }
  152.      end;
  153.  
  154. { In 32-bit .EXE file run-time relocations are written as varying size }
  155. { records, so we need many size definitions.                           }
  156. const
  157.      rIntSize16    = 8;
  158.      rIntSize32    = 10;
  159.      rOrdSize      = 8;
  160.      rNamSize16    = 8;
  161.      rNamSize32    = 10;
  162.      rAddSize16    = 10;
  163.      rAddSize32    = 12;
  164.  
  165. { Format of NR_STYPE(x)                                         }
  166. { 7 6 5 4 3 2 1 0  - bit no                                     }
  167. {     | | | | | |                                               }
  168. {     | | +-+-+-+--- Source type                                }
  169. {     | +----------- Fixup to 16:16 alias                       }
  170. {     +------------- List of source offset follows fixup record }
  171. const
  172.      nrSType       = $0F;               { Source type mask }
  173.      nrSByte       = $00;               { lo byte (8-bits)}
  174.      nrSSeg        = $02;               { 16-bit segment (16-bits) }
  175.      nrSPtr        = $03;               { 16:16 pointer (32-bits) }
  176.      nrSOff        = $05;               { 16-bit offset (16-bits) }
  177.      nrPtr48       = $06;               { 16:32 pointer (48-bits) }
  178.      nrOff32       = $07;               { 32-bit offset (32-bits) }
  179.      nrSoff32      = $08;               { 32-bit self-relative offset (32-bits) }
  180.  
  181.      nrSrcMask     = $0F;               { Source type mask }
  182.      nrAlias       = $10;               { Fixup to alias }
  183.      nrChain       = $20;               { List of source offset follows }
  184.                                         { fixup record, source offset field }
  185.                                         { in fixup record contains number }
  186.                                         { of elements in list }
  187.  
  188. { Format of NR_FLAGS(x) and lxrFLAGS(x):                                  }
  189. { 7 6 5 4 3 2 1 0  - bit no                                               }
  190. { | | | |   | | |                                                         }
  191. { | | | |   | +-+--- Reference type                                       }
  192. { | | | |   +------- Additive fixup                                       }
  193. { | | | +----------- 32-bit Target Offset Flag (1 - 32-bit; 0 - 16-bit)   }
  194. { | | +------------- 32-bit Additive Flag (1 - 32-bit; 0 - 16-bit)        }
  195. { | +--------------- 16-bit Object/Module ordinal (1 - 16-bit; 0 - 8-bit) }
  196. { +----------------- 8-bit import ordinal (1 - 8-bit;                     }
  197. {                                          0 - NR32BITOFF toggles         }
  198. {                                              between 16 and 32 bit      }
  199. {                                              ordinal)                   }
  200. const
  201.      nrRtype       = $03;               { Reference type mask }
  202.      nrRint        = $00;               { Internal reference }
  203.      nrRord        = $01;               { Import by ordinal }
  204.      nrRnam        = $02;               { Import by name }
  205.      nrAdd         = $04;               { Additive fixup }
  206.  
  207.      nrRent        = $03;               { Internal entry table fixup }
  208.  
  209.      nr32bitOff    = $10;               { 32-bit Target Offset }
  210.      nr32bitAdd    = $20;               { 32-bit Additive fixup }
  211.      nr16objMod    = $40;               { 16-bit Object/Module ordinal }
  212.      nr8bitOrd     = $80;               { 8-bit import ordinal }
  213.  
  214. { OBJECT TABLE }
  215.  
  216. { Object Table Entry }
  217. type
  218.      pObjTblRec = ^tObjTblRec;
  219.      tObjTblRec = record                { Flat .EXE object table entry }
  220.       oSize     : Longint;              { Object virtual size }
  221.       oBase     : Longint;              { Object base virtual address }
  222.       oFlags    : Longint;              { Attribute flags }
  223.       oPageMap  : Longint;              { Object page map index }
  224.       oMapSize  : Longint;              { Number of entries in object page map }
  225.       oReserved : Longint;              { Reserved }
  226.      end;
  227.  
  228. { Format of oFlags                                                           }
  229. {                                                                            }
  230. { High word of dword flag field is not used for now.                         }
  231. { Low word has the following format:                                         }
  232. { 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 0  - bit no                            }
  233. {  |  |  |  |     | | | | | | | | | | |                                      }
  234. {  |  |  |  |     | | | | | | | | | | +--- Readable Object                   }
  235. {  |  |  |  |     | | | | | | | | | +----- Writeable Object                  }
  236. {  |  |  |  |     | | | | | | | | +------- Executable Object                 }
  237. {  |  |  |  |     | | | | | | | +--------- Resource Object                   }
  238. {  |  |  |  |     | | | | | | +----------- Object is Discardable             }
  239. {  |  |  |  |     | | | | | +------------- Object is Shared                  }
  240. {  |  |  |  |     | | | | +--------------- Object has preload pages          }
  241. {  |  |  |  |     | | | +----------------- Object has invalid pages          }
  242. {  |  |  |  |     | | +------------------- Object is permanent and swappable }
  243. {  |  |  |  |     | +--------------------- Object is permanent and resident  }
  244. {  |  |  |  |     +----------------------- Object is permanent and long lockable}
  245. {  |  |  |  +----------------------------- 16:16 alias required (80x86 specific)}
  246. {  |  |  +-------------------------------- Big/Default bit setting (80x86 specific)}
  247. {  |  +----------------------------------- Object is conforming for code (80x86 specific)}
  248. {  +-------------------------------------- Object I/O privilege level (80x86 specific)}
  249.  
  250. const
  251.      objRead       = $00000001;         { Readable object   }
  252.      objWrite      = $00000002;         { Writeable object  }
  253.      objExec       = $00000004;         { Executable object }
  254.      objResource   = $00000008;         { Resource object   }
  255.      objDiscard    = $00000010;         { object is Discardable }
  256.      objShared     = $00000020;         { object is Shared }
  257.      objPreload    = $00000040;         { object has preload pages  }
  258.      objInvalid    = $00000080;         { object has invalid pages  }
  259.      lnkNonPerm    = $00000600;         { object is nonpermanent - should be }
  260.      objNonPerm    = $00000000;         { zero in the .EXE but LINK386 uses 6 }
  261.      objPerm       = $00000100;         { object is permanent and swappable }
  262.      objResident   = $00000200;         { object is permanent and resident }
  263.      objContig     = $00000300;         { object is resident and contiguous }
  264.      objDynamic    = $00000400;         { object is permanent and long locable }
  265.      objTypeMask   = $00000700;         { object type mask }
  266.      objAlias16    = $00001000;         { 16:16 alias required (80x86 specific) }
  267.      objBigDef     = $00002000;         { Big/Default bit setting (80x86 specific) }
  268.      objConform    = $00004000;         { object is conforming for code (80x86 specific)  }
  269.      objIOPL       = $00008000;         { object I/O privilege level (80x86 specific) }
  270.  
  271. { object Page Map entry }
  272.  
  273. type pObjMapRec = ^tObjMapRec;
  274.      tObjMapRec = record                 { object Page Table entry }
  275.       PageDataOffset : Longint;          { file offset of page }
  276.       PageSize       : SmallWord;        { # bytes of page data }
  277.       PageFlags      : SmallWord;        { Per-Page attributes }
  278.      end;
  279.  
  280. const
  281.      pgValid       = $0000;              { Valid Physical Page in .EXE }
  282.      pgIterData    = $0001;              { Iterated Data Page }
  283.      pgInvalid     = $0002;              { Invalid Page }
  284.      pgZeroed      = $0003;              { Zero Filled Page }
  285.      pgRange       = $0004;              { Range of pages }
  286.      pgIterData2   = $0005;              { Iterated Data Page Type II }
  287.  
  288. { RESOURCE TABLE }
  289.  
  290. { tResource - Resource Table Entry }
  291. type pResource = ^tResource;
  292.      tResource = record                   { Resource Table Entry }
  293.       resType : SmallWord;                { Resource type }
  294.       resName : SmallWord;                { Resource name }
  295.       resSize : Longint;                  { Resource size }
  296.       resObj  : SmallWord;                { Object number }
  297.       resOffs : Longint;                  { Offset within object }
  298.      end;
  299.  
  300. { Iteration Record format for 'EXEPACK'ed pages. (DCR1346)  }
  301.      pIterRec = ^tIterRec;
  302.      tIterRec = record
  303.       nIter    : SmallWord;               { number of iterations }
  304.       nBytes   : SmallWord;               { number of bytes }
  305.       IterData : Byte;                    { iterated data byte(s) }
  306.      end;
  307.  
  308. { ENTRY TABLE DEFINITIONS }
  309.  
  310.    { Entry Table bundle }
  311.      pEntryTblRec = ^tEntryTblRec;
  312.      tEntryTblRec = record
  313.       Count   : Byte;                     { Number of entries in this bundle }
  314.       BndType : Byte;                     { Bundle type }
  315.       Obj     : SmallWord;                { object number }
  316.      end;                                 { Follows entry types }
  317.  
  318.      pEntry = ^tEntry;
  319.      tEntry = record
  320.       Flags   : Byte;                     { Entry point flags }
  321.       Variant : record case byte of       { Entry variant }
  322.        0 : (Offset : tOffset);            { 16-bit/32-bit offset entry }
  323.        1 : (CallGate : record
  324.              Offset   : SmallWord;        { Offset in segment }
  325.              Selector : SmallWord;        { Callgate selector }
  326.             end);
  327.        2 : (Fwd : record                  { Forwarder }
  328.              ModOrd : SmallWord;          { Module ordinal number }
  329.              Value  : Longint;            { Proc name offset or ordinal }
  330.             end);
  331.       end;
  332.      end;
  333.  
  334. { Module format directive table }
  335. type
  336.      pDirTabRec = ^tDirTabRec;
  337.      tDirTabRec = record
  338.       DirN    : SmallWord;
  339.       DataLen : SmallWord;
  340.       DataOfs : Longint;
  341.      end;
  342. const
  343.      dtResident = $8000;
  344.      dtVerify   = $0001;
  345.      dtLangInfo = $0002;
  346.      dtCoProc   = $0003;
  347.      dtThreadSt = $0004;
  348.      dtCSetBrws = $0005;
  349.  
  350. const
  351.      fixEnt16      = 3;
  352.      fixEnt32      = 5;
  353.      gateEnt16     = 5;
  354.      fwdEnt        = 7;
  355.  
  356. { BUNDLE TYPES }
  357. const
  358.      btEmpty       = $00;                 { Empty bundle }
  359.      btEntry16     = $01;                 { 16-bit offset entry point }
  360.      btGate16      = $02;                 { 286 call gate (16-bit IOPL) }
  361.      btEntry32     = $03;                 { 32-bit offset entry point }
  362.      btEntryFwd    = $04;                 { Forwarder entry point }
  363.      btTypeInfo    = $80;                 { Typing information present flag }
  364.  
  365. { Format for lxEflags                      }
  366. {                                          }
  367. {  7 6 5 4 3 2 1 0  - bit no               }
  368. {  | | | | | | | |                         }
  369. {  | | | | | | | +--- exported entry       }
  370. {  | | | | | | +----- uses shared data     }
  371. {  +-+-+-+-+-+------- parameter word count }
  372. const
  373.      lxExport      = $01;                 { Exported entry }
  374.      lxShared      = $02;                 { Uses shared data }
  375.      lxParams      = $F8;                 { Parameter word count mask }
  376.  
  377. { Flags for forwarders only: }
  378. const
  379.      fwd_Ordinal   = $01;                 { Imported by ordinal }
  380.  
  381. {Name table entry record used to keep name table in memory}
  382. type
  383.      pNameTblRec = ^tNameTblRec;
  384.      tNameTblRec = record
  385.       Name : pString;
  386.       Ord  : SmallWord;
  387.      end;
  388.  
  389. {Structure used to keep entry table in memory}
  390. type
  391.      pEntBundleRec = ^tEntBundleRec;
  392.      tEntBundleRec = record
  393.       Header : tEntryTblRec;
  394.       DataSz : Longint;
  395.       Data   : pArrOfByte;
  396.      end;
  397.  
  398. const
  399.    { tLX object error codes }
  400.      lxeOK            = 0;
  401.      lxeReadError     = 1;
  402.      lxeWriteError    = 2;
  403.      lxeBadFormat     = 3;
  404.      lxeBadRevision   = 4;
  405.      lxeBadOrdering   = 5;
  406.      lxeInvalidCPU    = 6;
  407.      lxeBadOS         = 7;
  408.      lxeUnkEntBundle  = 8;        {Unknown entry bundle type}
  409.      lxeUnkPageFlags  = 9;        {Unknown page flags}
  410.      lxeInvalidPage   = 10;       {PageSize > 0 and Page is nil}
  411.      lxeNoMemory      = 11;
  412.      lxeInvalidStub   = 12;
  413.      lxeEAreadError   = 13;
  414.      lxeEAwriteError  = 14;
  415.    { tLX.Save flags definistion }
  416.      svfAlignFirstObj = $00000003;{First object alignment AND mask}
  417.      svfFOalnShift    = $00000000;{Align 1st object on lxPageShift bound}
  418.      svfFOalnNone     = $00000001;{Do not align 1st object at all}
  419.      svfFOalnSector   = $00000002;{Align 1st object on sector bound}
  420.      svfAlignEachObj  = $0000000C;{Other objects alignment AND mask}
  421.      svfEOalnShift    = $00000000;{Align objects on lxPageShift bound}
  422.      svfEOalnSector   = $00000008;{Align objects on sector bound}
  423.    { tLX.Pack flags definistion }
  424.      pkfRunLengthLvl  = $00000003;{Run-length pack method mask}
  425.      pkfRunLengthMin  = $00000000;{Find only 1-length repeated data}
  426.      pkfRunLengthMid  = $00000001;{Find data patterns up to 16 chars length}
  427.      pkfRunLengthMax  = $00000002;{Find ALL matching data (VERY SLOW!)}
  428.      pkfRunLength     = $00000010;{Pack using run-length packing}
  429.      pkfLempelZiv     = $00000020;{Pack using kinda Lempel-Ziv(WARP ONLY!)}
  430. type
  431.      pArrOfOT = ^tArrOfOT;
  432.      tArrOfOT = array[1..99] of tObjTblRec;
  433.      pArrOfOM = ^tArrOfOM;
  434.      tArrOfOM = array[1..99] of tObjMapRec;
  435.      pArrOfRS = ^tArrOfRS;
  436.      tArrOfRS = array[1..99] of tResource;
  437.      pArrOfMD = ^tArrOfMD;
  438.      tArrOfMD = array[1..99] of tDirTabRec;
  439.      tProgressFunc = function(Current,Max : Longint) : boolean;
  440.      pLX = ^tLX;
  441.      tLX = object(tObject)
  442.       Stub        : pArrOfByte;
  443.       StubSize    : Longint;
  444.       TimeStamp   : Longint;
  445.       FileAttr    : Longint;
  446.       Header      : tLXheader;
  447.       ObjTable    : pArrOfOT;
  448.       ObjMap      : pArrOfOM;
  449.       RsrcTable   : pArrOfRS;
  450.       ResNameTbl  : pDarray;
  451.       NResNameTbl : pDarray;
  452.       EntryTbl    : pDarray;
  453.       ModDirTbl   : pArrOfMD;
  454.       PerPageCRC  : pArrOfLong;
  455.       FixPageTbl  : pArrOfLong;
  456.       FixRecTbl   : pArrOfByte;
  457.       FixRecTblSz : Longint;
  458.       ImpModTbl   : pDarray;
  459.       ImpProcTbl  : pDarray;
  460.       Pages       : pArrOfPtr;
  461.       PageOrder   : pArrOfLong;
  462.       DebugInfo   : pArrOfByte;
  463.       Overlay     : pArrOfByte;
  464.       OverlaySize : Longint;
  465.       EA          : pDarray;
  466.       constructor Init;
  467.       procedure   Zero; virtual;
  468.       function    Load(const fName : string) : Byte;
  469.       function    Save(const fName : string; saveFlags : Longint) : Byte;
  470.       procedure   Unpack;
  471.       procedure   Pack(packFlags : longint; Progress : tProgressFunc);
  472.       function    ImportModuleTableSize : Longint;
  473.       procedure   FreeModule;
  474.       procedure   MinimizePage(PageNo : Longint);
  475.       function    UsedPage(PageNo : Longint) : boolean;
  476.       function    isPacked(newAlign,newStubSize,packFlags,saveFlags : longint) : boolean;
  477.       destructor  Done;virtual;
  478.      end;
  479.  
  480. Implementation uses Dos, os2base, Helpers;
  481.  
  482. constructor tLX.Init;
  483. begin
  484.  Zero;
  485. end;
  486.  
  487. procedure tLX.Zero;
  488. begin
  489.  inherited Zero;
  490.  Header.lxMagic := lxfMagic;
  491. {Header.lxBOrder := lxLEBO;}
  492. {Header.lxWOrder := lxLEWO;}
  493. {Header.lxLevel := 0;}             {commented out since they`re already zeros}
  494.  Header.lxCpu := lxCPU386;
  495.  Header.lxOS := 1;
  496.  Header.lxPageShift := 2;
  497. end;
  498.  
  499. {* Two utility procedures for the QuickSort routine: *}
  500. {* compare two pages and exchange two pages (below). *}
  501. Function lxCmpPages(var Buff; N1,N2 : longint) : boolean;
  502. var L1,L2 : Longint;
  503. begin
  504.  lxCmpPages := _ON;
  505.  with tLX(Buff) do
  506.   begin
  507.    with ObjMap^[PageOrder^[N1]] do
  508.     case PageFlags of
  509.      pgValid     : L1 := Header.lxDataPageOfs + PageDataOffset shl Header.lxPageShift;
  510.      pgIterData,
  511.      pgIterData2 : L1 := Header.lxIterMapOfs + PageDataOffset shl Header.lxPageShift;
  512.      pgInvalid,
  513.      pgZeroed    : L1 := $7FFFFFFF;
  514.     end;
  515.    with ObjMap^[PageOrder^[N2]] do
  516.     case PageFlags of
  517.      pgValid     : L2 := Header.lxDataPageOfs + PageDataOffset shl Header.lxPageShift;
  518.      pgIterData,
  519.      pgIterData2 : L2 := Header.lxIterMapOfs + PageDataOffset shl Header.lxPageShift;
  520.      pgInvalid,
  521.      pgZeroed    : L2 := $7FFFFFFF;
  522.     end;
  523.    if (L1 >= L2) or ((L1 = L2) and (N1 >= N2)) then exit;
  524.   end;
  525.  lxCmpPages := _OFF;
  526. end;
  527.  
  528. Procedure lxXchgPages(var Buff; N1,N2 : longint);
  529. begin
  530.  with tLX(Buff) do
  531.   XchgL(PageOrder^[N1], PageOrder^[N2]);
  532. end;
  533.  
  534. function tLX.Load;
  535. label locEx;
  536. var   F   : File;
  537.       fSz,lastData,I,
  538.       J,L : Longint;
  539.       S   : String;
  540.       NTR : pNameTblRec;
  541.       EBR : pEntBundleRec;
  542.       Res : Byte;
  543.  
  544. Procedure UpdateLast;
  545. var A : Longint;
  546. begin
  547.  A := FilePos(F);
  548.  if lastData < A then lastData := A;
  549. end;
  550.  
  551. begin
  552.  freeModule;
  553.  Res := lxeReadError;
  554.  Assign(F, fName);
  555.  if not ReadEAs(fName, EA) then begin Res := lxeEAreadError; GoTo locEx; end;
  556.  I := FileMode; FileMode := open_share_DenyWrite;
  557.  GetFAttr(F, FileAttr); Reset(F, 1); FileMode := I;
  558.  if inOutRes <> 0 then GoTo locEx;
  559.  Res := lxeBadFormat;
  560.  L := 0; lastData := 0;
  561.  fSz := FileSize(F);
  562.  GetFTime(F, TimeStamp);
  563.  repeat
  564.   FillChar(Header, sizeOf(Header), 0);
  565.   BlockRead(F, Header, sizeOf(Header));
  566.   if inOutRes <> 0 then GoTo locEx;
  567.   case Header.lxMagic of
  568.    lxfMagic  : break;
  569.    exeMagic1,
  570.    exeMagic2 : begin
  571.                 if pArrOfLong(@header)^[$0F] <= L then GoTo locEx;
  572.                 L := pArrOfLong(@header)^[$0F];
  573.                 if L > fSz - sizeOf(Header) then GoTo locEx;
  574.                 Seek(F, L); {Skip DOS stub}
  575.                end;
  576.    else GoTo locEx;
  577.   end;
  578.  until _OFF;
  579.  if (Header.lxBOrder <> lxLEBO) or (Header.lxWOrder <> lxLEBO)
  580.   then begin Res := lxeBadOrdering; GoTo locEx; end;
  581.  if (Header.lxCPU < lxCPU286) or (Header.lxCPU > lxCPUP5)
  582.   then begin Res := lxeInvalidCPU; GoTo locEx; end;
  583.  if (Header.lxLevel <> 0)
  584.   then begin Res := lxeBadRevision; GoTo locEx; end;
  585.  if (Header.lxOS <> 1)  {Not for OS/2}
  586.   then begin Res := lxeBadOS; GoTo locEx; end;
  587.  
  588. { Read in DOS stub }
  589.  stubSize := L; Seek(F, 0);
  590.  GetMem(Stub, stubSize);
  591.  BlockRead(F, Stub^, stubSize);
  592.  updateLast;
  593.  
  594. { Read Object Table }
  595.  if Header.lxObjTabOfs <> 0
  596.   then begin
  597.         Seek(F, StubSize + Header.lxObjTabOfs);
  598.         GetMem(ObjTable, Header.lxObjCnt * sizeOf(tObjTblRec));
  599.         BlockRead(F, ObjTable^, Header.lxObjCnt * sizeOf(tObjTblRec));
  600.         updateLast;
  601.        end;
  602.  
  603. { Read Object Page Map Table }
  604.  if Header.lxObjTabOfs <> 0
  605.   then begin
  606.         Seek(F, StubSize + Header.lxObjMapOfs);
  607.         GetMem(ObjMap, Header.lxMpages * sizeOf(tObjMapRec));
  608.         BlockRead(F, ObjMap^, Header.lxMpages * sizeOf(tObjMapRec));
  609.         updateLast;
  610.        end;
  611.  
  612.  if Header.lxRsrcTabOfs <> 0
  613.   then begin
  614.         Seek(F, StubSize + Header.lxRsrcTabOfs);
  615.         GetMem(RsrcTable, Header.lxRsrcCnt * sizeOf(tResource));
  616.         BlockRead(F, RsrcTable^, Header.lxRsrcCnt * sizeOf(tResource));
  617.         updateLast;
  618.        end;
  619.  
  620.  New(ResNameTbl, Init(10));
  621.  if Header.lxResTabOfs <> 0
  622.   then begin
  623.         Seek(F, StubSize + Header.lxResTabOfs);
  624.         repeat
  625.          BlockRead(F, S, sizeOf(Byte));
  626.          if S = '' then break;
  627.          BlockRead(F, S[1], length(S));
  628.          New(NTR);
  629.          NTR^.Name := NewStr(S);
  630.          BlockRead(F, NTR^.Ord, sizeOf(SmallWord));
  631.          ResNameTbl^.AddItem(NTR);
  632.         until inOutRes <> 0;
  633.         updateLast;
  634.        end;
  635.  
  636.  New(NResNameTbl, Init(10));
  637.  if Header.lxNResTabOfs <> 0
  638.   then begin
  639.         Seek(F, Header.lxNResTabOfs);
  640.         repeat
  641.          BlockRead(F, S, sizeOf(Byte));
  642.          if S = '' then break;
  643.          BlockRead(F, S[1], length(S));
  644.          New(NTR);
  645.          NTR^.Name := NewStr(S);
  646.          BlockRead(F, NTR^.Ord, sizeOf(SmallWord));
  647.          NResNameTbl^.AddItem(NTR);
  648.         until inOutRes <> 0;
  649.         updateLast;
  650.        end;
  651.  
  652.  New(EntryTbl, Init(10));
  653.  if Header.lxEntTabOfs <> 0
  654.   then begin
  655.         Seek(F, StubSize + Header.lxEntTabOfs);
  656.         repeat
  657.          New(EBR);
  658.          BlockRead(F, EBR^.Header.Count, sizeOf(EBR^.Header.Count));
  659.          if EBR^.Header.Count = 0
  660.           then begin Dispose(EBR); break; end;
  661.          BlockRead(F, EBR^.Header.BndType, sizeOf(EBR^.Header.BndType));
  662.          case EBR^.Header.BndType of
  663.           btEmpty    : EBR^.DataSz := 0;
  664.           btEntry16  : EBR^.DataSz := EBR^.Header.Count * fixEnt16;
  665.           btGate16   : EBR^.DataSz := EBR^.Header.Count * gateEnt16;
  666.           btEntry32  : EBR^.DataSz := EBR^.Header.Count * fixEnt32;
  667.           btEntryFwd : EBR^.DataSz := EBR^.Header.Count * fwdEnt;
  668.           else begin Res := lxeUnkEntBundle; Dispose(EBR); GoTo locEx; end;
  669.          end;
  670.          if EBR^.DataSz <> 0
  671.           then BlockRead(F, EBR^.Header.Obj, sizeOf(EBR^.Header.Obj));
  672.          GetMem(EBR^.Data, EBR^.DataSz);
  673.          BlockRead(F, EBR^.Data^, EBR^.DataSz);
  674.          EntryTbl^.AddItem(EBR);
  675.         until inOutRes <> 0;
  676.         updateLast;
  677.        end;
  678.  
  679.  if Header.lxDirTabOfs <> 0
  680.   then begin
  681.         Seek(F, StubSize + Header.lxDirTabOfs);
  682.         GetMem(ModDirTbl, Header.lxDirCnt * sizeOf(tResource));
  683.         BlockRead(F, ModDirTbl^, Header.lxDirCnt * sizeOf(tResource));
  684.         updateLast;
  685.        end;
  686.  
  687.  if Header.lxPageSumOfs <> 0
  688.   then begin
  689.         Seek(F, StubSize + Header.lxPageSumOfs);
  690.         GetMem(PerPageCRC, Header.lxMpages * sizeOf(Longint));
  691.         BlockRead(F, PerPageCRC^, Header.lxMpages * sizeOf(Longint));
  692.         updateLast;
  693.        end;
  694.  
  695.  if Header.lxFPageTabOfs <> 0
  696.   then begin
  697.         Seek(F, StubSize + Header.lxFPageTabOfs);
  698.         GetMem(FixPageTbl, succ(Header.lxMpages) * sizeOf(Longint));
  699.         BlockRead(F, FixPageTbl^, succ(Header.lxMpages) * sizeOf(Longint));
  700.         updateLast;
  701.        end;
  702.  
  703.  New(ImpModTbl, Init(10));
  704.  if Header.lxImpModOfs <> 0
  705.   then begin
  706.         Seek(F, StubSize + Header.lxImpModOfs);
  707.         For I := 1 to Header.lxImpModCnt do
  708.          begin
  709.           BlockRead(F, S, sizeOf(Byte));
  710.           BlockRead(F, S[1], length(S));
  711.           ImpModTbl^.AddItem(NewStr(S));
  712.          end;
  713.         updateLast;
  714.        end;
  715.  
  716.  New(ImpProcTbl, Init(10));
  717.  if Header.lxImpProcOfs <> 0
  718.   then begin
  719.         Seek(F, StubSize + Header.lxImpProcOfs);
  720.         I := Header.lxFPageTabOfs + Header.lxFixupSize - Header.lxImpProcOfs;
  721.         While I > 0 do
  722.          begin
  723.           BlockRead(F, S, sizeOf(Byte));
  724.           BlockRead(F, S[1], length(S));
  725.           ImpProcTbl^.AddItem(NewStr(S));
  726.           Dec(I, succ(length(S)));
  727.          end;
  728.         updateLast;
  729.        end;
  730.  
  731.  if Header.lxFRecTabOfs <> 0
  732.   then begin
  733.         Seek(F, StubSize + Header.lxFRecTabOfs);
  734.         FixRecTblSz := Header.lxImpModOfs - (Header.lxFPageTabOfs +
  735.          succ(Header.lxMpages) * sizeOf(Longint));
  736.         GetMem(FixRecTbl, FixRecTblSz);
  737.         BlockRead(F, FixRecTbl^, FixRecTblSz);
  738.         updateLast;
  739.        end;
  740.  
  741.  GetMem(Pages, Header.lxMpages * sizeOf(Pointer));
  742.  FillChar(Pages^, Header.lxMpages * sizeOf(Pointer), 0);
  743.  GetMem(PageOrder, Header.lxMpages * sizeOf(Longint));
  744.  For I := 1 to Header.lxMpages do
  745.   with ObjMap^[I] do
  746.    begin
  747.     PageOrder^[pred(I)] := I;
  748.     case PageFlags of
  749.      pgValid     : L := Header.lxDataPageOfs;
  750.      pgIterData,
  751.      pgIterData2 : L := Header.lxIterMapOfs;
  752.      pgInvalid,
  753.      pgZeroed    : begin
  754.                     PageDataOffset := 0;
  755.                     L := -1;
  756.                    end;
  757.      else{pgRange} begin Res := lxeUnkPageFlags; GoTo locEx; end;
  758.     end;
  759.     if L <> -1
  760.      then begin
  761.            Inc(L, PageDataOffset shl Header.lxPageShift);
  762.            if (L > fSz)
  763.             then if UsedPage(I)
  764.                   then goto locEx
  765.                   else begin
  766.                         PageSize := 0;
  767.                         PageDataOffset := 0;
  768.                         PageFlags := pgInvalid;
  769.                        end
  770.             else begin
  771.                   Seek(F, L);
  772.                   GetMem(Pages^[pred(I)], PageSize);
  773.                   BlockRead(F, Pages^[pred(I)]^, PageSize);
  774.                   updateLast;
  775.                  end;
  776.           end;
  777.    end;
  778. { Now sort the pages in the order they come in the file }
  779.  QuickSort(Self, 0, pred(Header.lxMpages), 0, lxCmpPages, lxXchgPages);
  780.  
  781.  if Header.lxDebugInfoOfs <> 0
  782.   then if Header.lxDebugInfoOfs >= sizeOf(F)
  783.         then Header.lxDebugInfoOfs := 0
  784.         else begin
  785.               Seek(F, Header.lxDebugInfoOfs);
  786.               GetMem(DebugInfo, Header.lxDebugLen);
  787.               BlockRead(F, DebugInfo^, Header.lxDebugLen);
  788.               updateLast;
  789.              end;
  790.  
  791.  OverlaySize := FileSize(F) - lastData;
  792.  GetMem(Overlay, OverlaySize);
  793.  Seek(F, lastData);
  794.  BlockRead(F, Overlay^, OverlaySize);
  795.  
  796.  if inOutRes <> 0 then GoTo locEx;
  797.  
  798.  Res := lxeOK;
  799. locEx:
  800.  if ioResult <> 0 then Res := lxeReadError;
  801.  if Res <> lxeOK then freeModule;
  802.  Load := Res;
  803.  Close(F); inOutRes := 0;
  804. end;
  805.  
  806. function tLX.Save;
  807. label locEx;
  808. var   F    : File;
  809.       Res  : Byte;
  810.       I,J,
  811.       K,L  : Longint;
  812.       pL   : pLong;
  813.       NTR  : pNameTblRec;
  814.       EBR  : pEntBundleRec;
  815.       ZeroB: pArrOfByte;
  816.       ZeroL: Longint;
  817. begin
  818. { The following fields in Header must be set up before Save: }
  819. { lxMpages      lxStartObj   lxEIP         lxStackObj
  820.   lxESP         lxPageSize   lxPageShift   lxObjCnt
  821.   lxRsrcCnt     lxDirCnt     lxAutoData }
  822.  Header.lxFixupSum := 0;
  823.  Header.lxLdrSum := 0;
  824.  Header.lxNResSum := 0;
  825.  {lxInstPreload := 0;{*}
  826.  {lxInstDemand := 0;{*}
  827.  {lxHeapSize := 0;{*}
  828.  if SaveFlags and svfAlignEachObj = svfEOalnSector
  829.   then begin
  830.         SaveFlags := (SaveFlags and not svfAlignFirstObj) or svfFOalnSector;
  831.         if Header.lxPageShift < 9 then Header.lxPageShift := 9;
  832.        end;
  833.  if (SaveFlags and svfAlignFirstObj = svfFOalnSector) and (Header.lxPageShift < 9)
  834.   then ZeroL := 512
  835.   else ZeroL := 1 shl Header.lxPageShift;
  836.  
  837.  GetMem(ZeroB, ZeroL);
  838.  if ZeroB = nil then begin Res := lxeNoMemory; GoTo locEx; end;
  839.  FillChar(ZeroB^, ZeroL, 0);
  840.  
  841.  Res := lxeOK; I := FileMode;
  842.  FileMode := open_access_ReadWrite or open_share_DenyReadWrite;
  843.  Assign(F, fName); SetFattr(F, 0); inOutRes := 0;
  844.  Rewrite(F, 1); FileMode := I; if inOutRes <> 0 then Goto locEx;
  845.  
  846. { Write stub to file. }
  847.  if ((Stub = nil) and (StubSize <> 0)) or ((StubSize < $40) and (StubSize > 0))
  848.   then begin Res := lxeInvalidStub; Goto locEx; end;
  849.  if (Stub <> nil)
  850.   then begin
  851.         pArrOfLong(Stub)^[$0F] := StubSize;
  852.         BlockWrite(F, Stub^, StubSize);
  853.        end;
  854.  
  855. { Temporary skip header }
  856.  Seek(F, StubSize + sizeOf(Header));
  857.  
  858. { Write Object Table }
  859.  if ObjTable <> nil
  860.   then begin
  861.         Header.lxObjTabOfs := FilePos(F) - StubSize;
  862.         BlockWrite(F, ObjTable^, Header.lxObjCnt * sizeOf(tObjTblRec));
  863.        end
  864.   else Header.lxObjTabOfs := 0;
  865.  
  866. { Temporary skip Object Page Map Table }
  867.  Seek(F, FilePos(F) + Header.lxMpages * sizeOf(tObjMapRec));
  868.  
  869. { Write resource table }
  870.  if RsrcTable <> nil
  871.   then begin
  872.         Header.lxRsrcTabOfs := FilePos(F) - StubSize;
  873.         BlockWrite(F, RsrcTable^, Header.lxRsrcCnt * sizeOf(tResource));
  874.        end
  875.   else Header.lxRsrcTabOfs := 0;
  876.  
  877. { Write resident name table }
  878.  Header.lxResTabOfs := FilePos(F) - StubSize;
  879.  For I := 1 to ResNameTbl^.numItems do
  880.   begin
  881.    NTR := ResNameTbl^.GetItem(I);
  882.    BlockWrite(F, NTR^.Name^, succ(length(NTR^.Name^)));
  883.    BlockWrite(F, NTR^.Ord, sizeOf(SmallWord));
  884.   end;
  885.  I := 0; BlockWrite(F, I, sizeOf(Byte));
  886.  
  887. { Write module entry table }
  888.  Header.lxEntTabOfs := FilePos(F) - StubSize;
  889.  For I := 1 to EntryTbl^.numItems do
  890.   begin
  891.    EBR := EntryTbl^.GetItem(I);
  892.    BlockWrite(F, EBR^.Header.Count, sizeOf(EBR^.Header.Count));
  893.    BlockWrite(F, EBR^.Header.BndType, sizeOf(EBR^.Header.BndType));
  894.    if EBR^.DataSz <> 0
  895.     then BlockWrite(F, EBR^.Header.Obj, sizeOf(EBR^.Header.Obj));
  896.    BlockWrite(F, EBR^.Data^, EBR^.DataSz);
  897.   end;
  898.  I := 0; BlockWrite(F, I, sizeOf(EBR^.Header.Count));
  899.  
  900. { Write module directives table }
  901.  if ModDirTbl <> nil
  902.   then begin
  903.         Header.lxDirTabOfs := FilePos(F) - StubSize;
  904.         BlockWrite(F, ModDirTbl^, Header.lxDirCnt * sizeOf(tResource));
  905.        end
  906.   else Header.lxDirTabOfs := 0;
  907.  
  908. { Write per-page checksum }
  909.  if PerPageCRC <> nil
  910.   then begin
  911.         Header.lxPageSumOfs := FilePos(F) - StubSize;
  912.         BlockWrite(F, PerPageCRC^, Header.lxMpages * sizeOf(Longint));
  913.        end
  914.   else Header.lxPageSumOfs := 0;
  915.  
  916.  Header.lxLdrSize := FilePos(F) - Header.lxObjTabOfs - StubSize;
  917.  
  918. { Write page fixup table }
  919.  L := FilePos(F);
  920.  
  921.  Header.lxFPageTabOfs := FilePos(F) - StubSize;
  922.  BlockWrite(F, FixPageTbl^, succ(Header.lxMpages) * sizeOf(Longint));
  923.  
  924. { Write fixup record table }
  925.  Header.lxFRecTabOfs := FilePos(F) - StubSize;
  926.  BlockWrite(F, FixRecTbl^, FixRecTblSz);
  927.  
  928. { Write imported modules table }
  929.  Header.lxImpModOfs := FilePos(F) - StubSize;
  930.  Header.lxImpModCnt := ImpModTbl^.numItems;
  931.  For I := 1 to Header.lxImpModCnt do
  932.   if ImpModTbl^.GetItem(I) <> nil
  933.    then BlockWrite(F, ImpModTbl^.GetItem(I)^,
  934.          succ(length(pString(ImpModTbl^.GetItem(I))^)))
  935.    else BlockWrite(F, ZeroB^, 1);
  936.  
  937. { Write imported procedures table }
  938.  Header.lxImpProcOfs := FilePos(F) - StubSize;
  939.  For I := 1 to ImpProcTbl^.numItems do
  940.   if ImpProcTbl^.GetItem(I) <> nil
  941.    then BlockWrite(F, ImpProcTbl^.GetItem(I)^,
  942.          succ(length(pString(ImpProcTbl^.GetItem(I))^)))
  943.    else BlockWrite(F, ZeroB^, 1);
  944.  
  945. { Calculate fixup section size }
  946.  Header.lxFixupSize := FilePos(F) - L;
  947.  
  948. { Now write the data/code pages }
  949.  L := FilePos(F);
  950.  case SaveFlags and svfAlignFirstObj of
  951.   svfFOalnNone   : I := L;
  952.   svfFOalnShift  : I := (L + pred(1 shl Header.lxPageShift)) and
  953.                         ($FFFFFFFF shl Header.lxPageShift);
  954.   svfFOalnSector : I := (L + 511) and $FFFFFE00;
  955.  end;
  956.  BlockWrite(F, ZeroB^, I - L);
  957.  
  958.  Header.lxDataPageOfs := 0;
  959.  Header.lxIterMapOfs := 0;
  960.  Header.lxDataPageOfs := FilePos(F);
  961.  For I := 1 to Header.lxMpages do
  962.   begin
  963.    K := PageOrder^[pred(I)];
  964.    with ObjMap^[K] do
  965.     begin
  966.      case PageFlags of
  967.       pgValid     : pL := @Header.lxDataPageOfs;
  968.       pgIterData,
  969.       pgIterData2 : begin
  970.                      Header.lxIterMapOfs := Header.lxDataPageOfs;
  971.                      pL := @Header.lxIterMapOfs;
  972.                     end;
  973.       pgInvalid,
  974.       pgZeroed    : pL := nil;
  975.       else{pgRange} begin Res := lxeUnkPageFlags; GoTo locEx; end;
  976.      end;
  977.      if pL <> nil
  978.       then begin
  979.             if (Pages^[pred(K)] = nil) and (PageSize <> 0)
  980.              then begin Res := lxeInvalidPage; GoTo locEx; end;
  981.             MinimizePage(K);
  982.             J := FilePos(F);
  983.             L := (J - pL^ + pred(1 shl Header.lxPageShift)) and
  984.                  ($FFFFFFFF shl Header.lxPageShift);
  985.             if pL^ + L > J then BlockWrite(F, ZeroB^, pL^ + L - J);
  986.             PageDataOffset := L shr Header.lxPageShift;
  987.             BlockWrite(F, Pages^[pred(K)]^, PageSize);
  988.            end
  989.       else PageDataOffset := 0;
  990.     end;
  991.   end;
  992.  
  993. { And now write the non-resident names table }
  994.  if NResNameTbl^.numItems > 0
  995.   then begin
  996.         Header.lxNResTabOfs := FilePos(F);
  997.         For I := 1 to NResNameTbl^.numItems do
  998.          begin
  999.           NTR := NResNameTbl^.GetItem(I);
  1000.           BlockWrite(F, NTR^.Name^, succ(length(NTR^.Name^)));
  1001.           BlockWrite(F, NTR^.Ord, sizeOf(SmallWord));
  1002.          end;
  1003.         I := 0; BlockWrite(F, I, sizeOf(Byte));
  1004.         Header.lxCbNResTabOfs := FilePos(F) - Header.lxNResTabOfs;
  1005.        end
  1006.   else begin
  1007.         Header.lxNResTabOfs := 0;
  1008.         Header.lxCbNResTabOfs := 0;
  1009.        end;
  1010.  
  1011.  if Header.lxDebugInfoOfs <> 0
  1012.   then begin
  1013.         Header.lxDebugInfoOfs := FilePos(F);
  1014.         BlockWrite(F, DebugInfo^, Header.lxDebugLen);
  1015.        end;
  1016.  
  1017.  if OverlaySize <> 0
  1018.   then BlockWrite(F, Overlay^, OverlaySize);
  1019.  
  1020.  Seek(F, StubSize + sizeOf(Header) + Header.lxObjCnt * sizeOf(tObjTblRec));
  1021. { Now write Object Page Map Table }
  1022.  if ObjMap <> nil
  1023.   then begin
  1024.         Header.lxObjMapOfs := FilePos(F) - StubSize;
  1025.         BlockWrite(F, ObjMap^, Header.lxMpages * sizeOf(tObjMapRec));
  1026.        end
  1027.   else Header.lxObjMapOfs := 0;
  1028.  
  1029. { Now seek to beginning and write the LX header }
  1030.  Seek(F, StubSize);
  1031.  BlockWrite(F, Header, sizeOf(Header));
  1032.  
  1033. locEx:
  1034.  if ZeroB <> nil then FreeMem(ZeroB, ZeroL);
  1035.  if ioResult <> 0 then Res := lxeWriteError;
  1036.  if TimeStamp <> 0 then SetFTime(F, TimeStamp);
  1037.  Save := Res;  Close(F); inOutRes := 0;
  1038.  if FileAttr <> 0 then SetFattr(F, FileAttr);
  1039.  if (Res = lxeOK) and (not WriteEAs(fName, EA))
  1040.   then Save := lxeEAwriteError;
  1041. end;
  1042.  
  1043. procedure tLX.freeModule;
  1044. var I   : Longint;
  1045.     NTR : pNameTblRec;
  1046.     EBR : pEntBundleRec;
  1047. begin
  1048.  if PageOrder <> nil
  1049.   then FreeMem(PageOrder, Header.lxMpages * sizeOf(Pointer));
  1050.  
  1051.  if Pages <> nil
  1052.   then begin
  1053.         For I := 1 to Header.lxMpages do
  1054.          if Pages^[pred(I)] <> nil
  1055.           then FreeMem(Pages^[pred(I)], ObjMap^[I].PageSize);
  1056.         FreeMem(Pages, Header.lxMpages * sizeOf(Pointer));
  1057.        end;
  1058.  
  1059.  if FixRecTbl <> nil
  1060.   then FreeMem(FixRecTbl, FixRecTblSz);
  1061.  
  1062.  if ImpProcTbl <> nil
  1063.   then begin
  1064.         For I := 1 to ImpProcTbl^.numItems do
  1065.          if ImpProcTbl^.GetItem(I) <> nil
  1066.           then DisposeStr(ImpProcTbl^.GetItem(I));
  1067.         Dispose(ImpProcTbl, Done);
  1068.        end;
  1069.  
  1070.  if ImpModTbl <> nil
  1071.   then begin
  1072.         For I := 1 to ImpModTbl^.numItems do
  1073.          if ImpModTbl^.GetItem(I) <> nil
  1074.           then DisposeStr(ImpModTbl^.GetItem(I));
  1075.         Dispose(ImpModTbl, Done);
  1076.        end;
  1077.  
  1078.  if FixPageTbl <> nil
  1079.   then FreeMem(FixPageTbl, succ(Header.lxMpages) * sizeOf(Longint));
  1080.  
  1081.  if PerPageCRC <> nil
  1082.   then FreeMem(PerPageCRC, Header.lxMpages * sizeOf(Longint));
  1083.  
  1084.  if ModDirTbl <> nil
  1085.   then FreeMem(ModDirTbl, Header.lxDirCnt * sizeOf(tResource));
  1086.  
  1087.  if EntryTbl <> nil
  1088.   then begin
  1089.         For I := 1 to EntryTbl^.numItems do
  1090.          begin
  1091.           EBR := EntryTbl^.GetItem(I);
  1092.           FreeMem(EBR^.Data, EBR^.DataSz);
  1093.           Dispose(EBR);
  1094.          end;
  1095.         Dispose(EntryTbl, Done);
  1096.        end;
  1097.  
  1098.  if NResNameTbl <> nil
  1099.   then begin
  1100.         For I := 1 to NResNameTbl^.numItems do
  1101.          begin
  1102.           NTR := NResNameTbl^.GetItem(I);
  1103.           DisposeStr(NTR^.Name);
  1104.           Dispose(NTR);
  1105.          end;
  1106.         Dispose(NResNameTbl, Done);
  1107.        end;
  1108.  
  1109.  if ResNameTbl <> nil
  1110.   then begin
  1111.         For I := 1 to ResNameTbl^.numItems do
  1112.          begin
  1113.           NTR := ResNameTbl^.GetItem(I);
  1114.           DisposeStr(NTR^.Name);
  1115.           Dispose(NTR);
  1116.          end;
  1117.         Dispose(ResNameTbl, Done);
  1118.        end;
  1119.  
  1120.  if RsrcTable <> nil
  1121.   then FreeMem(RsrcTable, Header.lxRsrcCnt * sizeOf(tResource));
  1122.  
  1123.  if ObjMap <> nil
  1124.   then FreeMem(ObjMap, Header.lxMpages * sizeOf(tObjMapRec));
  1125.  
  1126.  if ObjTable <> nil
  1127.   then FreeMem(ObjTable, Header.lxObjCnt * sizeOf(tObjTblRec));
  1128.  
  1129.  if stubSize <> 0
  1130.   then FreeMem(Stub, StubSize);
  1131.  
  1132.  if OverlaySize <> 0
  1133.   then FreeMem(Overlay, OverlaySize);
  1134.  
  1135.  if EA <> nil then FreeEAs(EA);
  1136.  Zero;
  1137. end;
  1138.  
  1139. function tLX.ImportModuleTableSize;
  1140. var I,L : Longint;
  1141. begin
  1142.  L := 0;
  1143.  For I := 1 to ImpModTbl^.numItems do
  1144.   Inc(L, succ(length(pString(ImpModTbl^.GetItem(I))^)));
  1145.  ImportModuleTableSize := L;
  1146. end;
  1147.  
  1148. Function UnpackMethod1(var srcData, destData; srcDataSize : Longint;
  1149.                        var dstDataSize : longint) : boolean;
  1150. var src     : tArrOfByte absolute srcData;
  1151.     dst     : tArrOfByte absolute destData;
  1152.     sOf,dOf : Longint;
  1153.     nI,cB   : SmallWord;
  1154.  
  1155. Function srcAvail(N : Longint) : boolean;
  1156. begin
  1157.  srcAvail := sOf + N <= srcDataSize;
  1158. end;
  1159.  
  1160. Function dstAvail(N : Longint) : boolean;
  1161. begin
  1162.  dstAvail := dOf + N <= dstDataSize;
  1163. end;
  1164.  
  1165. begin
  1166.  UnpackMethod1 := _OFF;
  1167.  sOf := 0; dOf := 0;
  1168.  repeat
  1169.   if not srcAvail(1) then break;
  1170.   if not srcAvail(2+2) then exit;
  1171.   nI := pSmallWord(@src[sOf])^;
  1172.   cB := pSmallWord(@src[sOf+2])^;
  1173.   Inc(sOf, 2+2);
  1174.   if srcAvail(cB) and dstAvail(cB * nI)
  1175.    then if nI > 0
  1176.          then begin
  1177.                linearMove(src[sOf], dst[dOf], cB);
  1178.                linearMove(dst[dOf], dst[dOf + cB], cB * pred(nI));
  1179.                Inc(dOf, cB * nI);
  1180.               end
  1181.          else
  1182.    else exit;
  1183.   Inc(sOf, cB);
  1184.  until dOf >= dstDataSize;
  1185.  FillChar(dst[dOf], dstDataSize - dOf, 0);
  1186.  dstDataSize := dOf;
  1187.  UnpackMethod1 := _ON;
  1188. end;
  1189.  
  1190. Function UnpackMethod2(var srcData, destData; srcDataSize : Longint;
  1191.                        var dstDataSize : Longint) : boolean;
  1192. var src   : tArrOfByte absolute srcData;
  1193.     dst   : tArrOfByte absolute destData;
  1194.     B1,B2 : Byte;
  1195.     sOf,dOf,
  1196.     bOf   : Longint;
  1197.  
  1198. Function srcAvail(N : Longint) : boolean;
  1199. begin
  1200.  srcAvail := sOf + N <= srcDataSize;
  1201. end;
  1202.  
  1203. Function dstAvail(N : Longint) : boolean;
  1204. begin
  1205.  dstAvail := dOf + N <= dstDataSize;
  1206. end;
  1207.  
  1208. begin
  1209.  UnpackMethod2 := _OFF;
  1210.  sOf := 0; dOf := 0;
  1211.  repeat
  1212.   if not srcAvail(1) then break;
  1213.   B1 := src[sOf];
  1214.   case B1 and 3 of
  1215.    0 : if B1 = 0
  1216.         then if srcAvail(2)
  1217.               then if src[succ(sOf)] = 0
  1218.                     then begin Inc(sOf, 2); break; end
  1219.                     else if srcAvail(3) and dstAvail(src[succ(sOf)])
  1220.                           then begin
  1221.                                 FillChar(dst[dOf], src[succ(sOf)], src[sOf+2]);
  1222.                                 Inc(sOf, 3); Inc(dOf, src[sOf-2]);
  1223.                                end
  1224.                           else exit
  1225.               else exit
  1226.         else if srcAvail(succ(B1 shr 2)) and dstAvail(B1 shr 2)
  1227.               then begin
  1228.                     linearMove(src[succ(sOf)], dst[dOf], B1 shr 2);
  1229.                     Inc(dOf, B1 shr 2);
  1230.                     Inc(sOf, succ(B1 shr 2));
  1231.                    end
  1232.               else exit;
  1233.    1 : begin
  1234.         if not srcAvail(2) then exit;
  1235.         bOf := pSmallWord(@src[sOf])^ shr 7;
  1236.         B2 := (B1 shr 4) and 7 + 3;
  1237.         B1 := (B1 shr 2) and 3;
  1238.         if srcAvail(2 + B1) and dstAvail(B1 + B2) and (dOf + B1 - bOf >= 0)
  1239.          then begin
  1240.                linearMove(src[sOf + 2], dst[dOf], B1);
  1241.                Inc(dOf, B1); Inc(sOf, 2 + B1);
  1242.                linearMove(dst[dOf - bOf], dst[dOf], B2);
  1243.                Inc(dOf, B2);
  1244.               end
  1245.          else exit;
  1246.        end;
  1247.    2 : begin
  1248.         if not srcAvail(2) then exit;
  1249.         bOf := pSmallWord(@src[sOf])^ shr 4;
  1250.         B1 := (B1 shr 2) and 3 + 3;
  1251.         if dstAvail(B1) and (dOf - bOf >= 0)
  1252.          then begin
  1253.                linearMove(dst[dOf - bOf], dst[dOf], B1);
  1254.                Inc(dOf, B1); Inc(sOf, 2);
  1255.               end
  1256.          else exit;
  1257.        end;
  1258.    3 : begin
  1259.         if not srcAvail(3) then exit;
  1260.         B2 := (pSmallWord(@src[sOf])^ shr 6) and $3F;
  1261.         B1 := (src[sOf] shr 2) and $0F;
  1262.         bOf := pSmallWord(@src[succ(sOf)])^ shr 4;
  1263.         if srcAvail(3 + B1) and dstAvail(B1 + B2) and (dOf + B1 - bOf >= 0)
  1264.          then begin
  1265.                linearMove(src[sOf + 3], dst[dOf], B1);
  1266.                Inc(dOf, B1); Inc(sOf, 3 + B1);
  1267.                linearMove(dst[dOf - bOf], dst[dOf], B2);
  1268.                Inc(dOf, B2);
  1269.               end
  1270.          else exit;
  1271.        end;
  1272.   end;
  1273.  until dOf >= dstDataSize;
  1274.  FillChar(dst[dOf], dstDataSize - dOf, 0);
  1275.  dstDataSize := dOf;
  1276.  UnpackMethod2 := _ON;
  1277. end;
  1278.  
  1279. procedure tLX.Unpack;
  1280. var I,J     : Longint;
  1281.     uD,pD   : pArrOfByte;
  1282.     UnpFunc : Function(var srcData, destData; srcDataSize : longint; var dstDataSize : Longint) : boolean;
  1283. begin
  1284.  For I := 1 to Header.lxMpages do
  1285.   with ObjMap^[I] do
  1286.    begin
  1287.     case PageFlags of
  1288.      pgIterData  : @UnpFunc := @UnpackMethod1;
  1289.      pgIterData2 : @UnpFunc := @UnpackMethod2;
  1290.      pgValid     : @UnpFunc := nil;
  1291.      else Continue;
  1292.     end;
  1293.     pD := Pages^[pred(I)];
  1294.     if @UnpFunc <> nil
  1295.      then begin
  1296.            GetMem(uD, Header.lxPageSize); J := Header.lxPageSize;
  1297.            if UnpFunc(pD^, uD^, PageSize, J)
  1298.             then begin
  1299.                   FreeMem(pD, PageSize);
  1300.                   GetMem(pD, J);
  1301.                   linearMove(uD^, pD^, J);
  1302.                   PageSize := J;
  1303.                   PageFlags := pgValid;
  1304.                   Pages^[pred(I)] := pD;
  1305.                  end;
  1306.            FreeMem(uD, Header.lxPageSize); {Unpack error}
  1307.           end;
  1308.     J := PageSize;
  1309.     While (J > 0) and (pD^[pred(J)] = 0) do Dec(J);
  1310.     if J <> PageSize
  1311.      then begin
  1312.            GetMem(uD, J);
  1313.            Move(pD^, uD^, J);
  1314.            Pages^[pred(I)] := uD;
  1315.            FreeMem(pD, PageSize);
  1316.            PageSize := J;
  1317.           end;
  1318.    end;
  1319. end;
  1320.  
  1321. function PackMethod1(var srcData,dstData; srcDataSize : longint;
  1322.                      var dstDataSize : Longint; packLevel : byte) : boolean;
  1323. var sOf,dOf,tOf,
  1324.     MatchOff,
  1325.     MatchCnt,
  1326.     MatchLen : Longint;
  1327.     src      : tArrOfByte absolute srcData;
  1328.     dst      : tArrOfByte absolute dstData;
  1329.  
  1330. {$uses ebx,esi,edi}
  1331. {!workaround!}
  1332. {This procedure ACCESSES external data (tOf for example)}
  1333. {but VP beta does not update the EBP register}
  1334. function Search : boolean; assembler;
  1335. asm             cld
  1336.                 mov     esi,srcData
  1337.                 mov     edi,esi
  1338.                 add     edi,tOf[-4] {!!! and so on !!!}
  1339.                 add     esi,sOf[-4]
  1340.                 xor     eax,eax
  1341.                 movzx   ecx,packLevel
  1342.                 cmp     cl,255
  1343.                 je      @@setStart
  1344.                 mov     ebx,edi
  1345.                 sub     ebx,esi
  1346.                 cmp     ebx,ecx
  1347.                 jbe     @@setStart
  1348.                 mov     eax,ebx
  1349.                 sub     eax,ecx
  1350. @@setStart:     mov     MatchOff[-4],eax
  1351.                 add     esi,eax
  1352. @@nextPatt:     push    esi
  1353.                 push    edi
  1354.                 mov     eax,srcDataSize
  1355.                 sub     eax,tOf[-4]
  1356.                 mov     ebx,edi
  1357.                 sub     ebx,esi
  1358.                 cmp     ebx,eax
  1359.                 ja      @@noMatch
  1360.                 xor     edx,edx
  1361.                 div     ebx
  1362.                 mov     edx,eax                 {EDX = EAX = max matches}
  1363. @@nextMatch:    mov     ecx,ebx                 {EBX = ECX = pattern length}
  1364.                 repe    cmpsb
  1365.                 jne     @@notEQ
  1366.                 dec     eax
  1367.                 jnz     @@nextMatch
  1368. @@notEQ:        cmp     eax,edx
  1369.                 je      @@noMatch
  1370.                 sub     eax,edx
  1371.                 neg     eax
  1372.                 inc     eax                     {EAX = number of actual matches}
  1373.                 mov     edx,ebx
  1374.                 db      $0F,$AF,$D8             {imul    ebx,eax}
  1375.                 sub     ebx,2+2
  1376.                 jc      @@noMatch
  1377.                 cmp     ebx,edx
  1378.                 jbe     @@noMatch
  1379.                 mov     MatchCnt[-4],eax
  1380.                 mov     MatchLen[-4],edx
  1381.                 pop     esi
  1382.                 pop     edi
  1383.                 mov     al,1
  1384.                 jmp     @@locEx
  1385. @@noMatch:      pop     edi
  1386.                 pop     esi
  1387.                 inc     esi
  1388.                 inc     MatchOff[-4]
  1389.                 cmp     esi,edi
  1390.                 jb      @@nextPatt
  1391.                 mov     al,0
  1392. @@locEx:
  1393. end;
  1394. {$uses none}
  1395.  
  1396. function dstAvail(N : Longint) : boolean;
  1397. begin
  1398.  dstAvail := dOf + N <= dstDataSize;
  1399. end;
  1400.  
  1401. function PutNonpackedData : boolean;
  1402. begin
  1403.  PutNonpackedData := _ON;
  1404.  if MatchOff > 0
  1405.   then if dstAvail(2+2+MatchOff)
  1406.         then begin
  1407.               pSmallWord(@dst[dOf])^ := 1; Inc(dOf, 2);
  1408.               pSmallWord(@dst[dOf])^ := MatchOff; Inc(dOf, 2);
  1409.               Move(src[sOf], dst[dOf], MatchOff);
  1410.               Inc(dOf, MatchOff); Inc(sOf, MatchOff);
  1411.              end
  1412.         else PutNonpackedData := _OFF;
  1413. end;
  1414.  
  1415. begin
  1416.  PackMethod1 := _OFF;
  1417.  sOf := 0; dOf := 0;
  1418.  repeat
  1419.   tOf := succ(sOf);
  1420.   While tOf < srcDataSize do
  1421.    begin
  1422.     if Search
  1423.      then begin
  1424.            if (not PutNonpackedData) or
  1425.               (not dstAvail(2+2+MatchLen)) then exit;
  1426.            pSmallWord(@dst[dOf])^ := MatchCnt; Inc(dOf, 2);
  1427.            pSmallWord(@dst[dOf])^ := MatchLen; Inc(dOf, 2);
  1428.            linearMove(src[sOf], dst[dOf], MatchLen);
  1429.            Inc(sOf, MatchCnt * MatchLen); Inc(dOf, MatchLen);
  1430.            break;
  1431.           end
  1432.      else Inc(tOf);
  1433.    end;
  1434.  until tOf >= srcDataSize;
  1435.  MatchOff := srcDataSize - sOf;
  1436.  if (not PutNonpackedData) or (sOf <= dOf) then exit;
  1437.  dstDataSize := dOf;
  1438.  PackMethod1 := _ON;
  1439. end;
  1440.  
  1441. function PackMethod2(var srcData,dstData; srcDataSize : longint; var dstDataSize : Longint) : boolean;
  1442. label skip,locEx;
  1443. var   Chain       : pArrOfSmallWord;
  1444.       ChainHead   : pArrOfSmallWord;
  1445.       sOf,dOf,tOf,I,J,
  1446.       maxMatchLen,
  1447.       maxMatchPos : Longint;
  1448.       src         : tArrOfByte absolute srcData;
  1449.       dst         : tArrOfByte absolute dstData;
  1450.  
  1451. {$uses esi,edi,ebx}
  1452. {!workaround!}
  1453. {See above}
  1454. function Search : boolean; assembler;
  1455. asm             cld
  1456.                 mov     edx,srcDataSize
  1457.                 sub     edx,tOf[-4]
  1458.                 mov     al,0
  1459.                 cmp     edx,2
  1460.                 jbe     @@locEx
  1461.                 mov     esi,srcData
  1462.                 mov     edi,esi
  1463.                 add     esi,tOf[-4]
  1464.                 mov     ax,[esi]
  1465.                 and     eax,0FFFh
  1466.                 shl     eax,1
  1467.                 add     eax,ChainHead[-4]
  1468.                 and     maxMatchLen[-4],0
  1469.  
  1470. @@nextSearch:   push    esi
  1471.                 movsx   edi,word ptr [eax]
  1472.                 cmp     edi,-1
  1473.                 je      @@endOfChain
  1474.                 mov     eax,edi
  1475.                 shl     eax,1
  1476.                 add     eax,Chain[-4]
  1477.                 add     edi,srcData
  1478.                 mov     ecx,edx
  1479.                 repe    cmpsb
  1480.                 jz      @@maxLen
  1481.                 pop     esi
  1482.                 sub     ecx,edx
  1483.                 neg     ecx
  1484.                 sub     edi,ecx
  1485.                 dec     ecx
  1486.                 cmp     ecx,maxMatchLen[-4]
  1487.                 jbe     @@nextSearch
  1488.                 sub     edi,srcData
  1489.                 mov     maxMatchLen[-4],ecx
  1490.                 mov     maxMatchPos[-4],edi
  1491.                 mov     ebx,tOf[-4]
  1492.                 dec     ebx
  1493.                 cmp     ebx,edi                 {Prefer RL encoding since it}
  1494.                 jne     @@nextSearch            {packs longer strings}
  1495.                 cmp     ecx,63                  {Strings up to 63 chars are always}
  1496.                 jbe     @@nextSearch            {packed effectively enough}
  1497.                 push    esi
  1498.                 jmp     @@endOfChain
  1499.  
  1500. @@maxLen:       sub     edi,edx
  1501.                 sub     edi,srcData
  1502.                 mov     maxMatchLen[-4],edx
  1503.                 mov     maxMatchPos[-4],edi
  1504.  
  1505. @@endOfChain:   mov     al,0
  1506.                 cmp     maxMatchLen[-4],3
  1507.                 jb      @@noMatch
  1508.                 inc     al
  1509. @@noMatch:      pop     esi
  1510. @@locEx:
  1511. end;
  1512. {$uses none}
  1513.  
  1514. function dstAvail(N : Longint) : boolean;
  1515. begin
  1516.  dstAvail := dOf + N <= dstDataSize;
  1517. end;
  1518.  
  1519. procedure Register(sOf, Count : Longint);
  1520. var I : Longint;
  1521. begin
  1522.  While (Count > 0) and (sOf < pred(srcDataSize)) do
  1523.   begin
  1524.    I := pSmallWord(@src[sOf])^ and $FFF;
  1525.    Chain^[sOf] := ChainHead^[I];
  1526.    ChainHead^[I] := sOf;
  1527.    Inc(sOf); Dec(Count);
  1528.   end;
  1529. end;
  1530.  
  1531. procedure Deregister(sOf : Longint);
  1532. var I : Longint;
  1533. begin
  1534.  I := pSmallWord(@src[sOf])^ and $FFF;
  1535.  ChainHead^[I] := Chain^[sOf];
  1536. end;
  1537.  
  1538. begin
  1539.  PackMethod2 := _OFF;
  1540.  GetMem(Chain, srcDataSize * 2);
  1541.  GetMem(ChainHead, (1 shl 12) * 2);
  1542.  FillChar(ChainHead^, (1 shl 12) * 2, $FF);
  1543.  sOf := 0; dOf := 0;
  1544.  repeat
  1545.   tOf := sOf;
  1546.   while tOf < srcDataSize do
  1547.    if Search
  1548.     then begin
  1549.           if (maxMatchPos = pred(tOf))
  1550.            then begin
  1551.                  if tOf > sOf then
  1552.                   begin
  1553.                    Inc(maxMatchLen);
  1554.                    Dec(tOf); Deregister(tOf);
  1555.                   end;
  1556.                  if maxMatchLen = 3 then goto skip;
  1557.                  while sOf < tOf do
  1558.                   begin
  1559.                    I := MinL(tOf - sOf, 63);
  1560.                    if not dstAvail(succ(I)) then goto locEx;
  1561.                    dst[dOf] := I shl 2;
  1562.                    linearMove(src[sOf], dst[succ(dOf)], I);
  1563.                    Inc(sOf, I); Inc(dOf, succ(I));
  1564.                   end;
  1565.                  while maxMatchLen > 3 do
  1566.                   begin
  1567.                    if not dstAvail(3) then goto locEx;
  1568.                    I := MinL(maxMatchLen, 255);
  1569.                    dst[dOf] := 0;
  1570.                    dst[dOf+1] := I;
  1571.                    dst[dOf+2] := src[sOf];
  1572.                    Register(sOf, I);
  1573.                    Inc(sOf, I); Inc(dOf, 3);
  1574.                    Dec(maxMatchLen, I);
  1575.                   end;
  1576.                 end
  1577.            else begin
  1578.                  if (tOf - maxMatchPos < 512) and (maxMatchLen <= 10)
  1579.                   then J := 3
  1580.                   else
  1581.                  if (maxMatchLen <= 6)
  1582.                   then J := 0
  1583.                   else J := 15;
  1584.                  while (sOf < tOf - J) do
  1585.                   begin
  1586.                    I := MinL(tOf - sOf, 63);
  1587.                    if not dstAvail(succ(I)) then goto locEx;
  1588.                    dst[dOf] := I shl 2;
  1589.                    linearMove(src[sOf], dst[succ(dOf)], I);
  1590.                    Inc(sOf, I); Inc(dOf, succ(I));
  1591.                   end;
  1592.                  case byte(J) of
  1593.                   3  : begin
  1594.                         if not dstAvail(2 + tOf - sOf) then goto locEx;
  1595.                         pSmallWord(@dst[dOf])^ := 1 + (tOf - sOf) shl 2 +
  1596.                          (maxMatchLen - 3) shl 4 + (tOf - maxMatchPos) shl 7;
  1597.                         linearMove(src[sOf], dst[dOf + 2], tOf - sOf);
  1598.                         Register(tOf, maxMatchLen);
  1599.                         Inc(dOf, 2 + tOf - sOf);
  1600.                         sOf := tOf + maxMatchLen;
  1601.                        end;
  1602.                   0  : begin
  1603.                         if not dstAvail(2) then goto locEx;
  1604.                         pSmallWord(@dst[dOf])^ := 2 + (maxMatchLen - 3) shl 2 +
  1605.                          (tOf - maxMatchPos) shl 4;
  1606.                         Register(tOf, maxMatchLen);
  1607.                         Inc(dOf, 2);
  1608.                         sOf := tOf + maxMatchLen;
  1609.                        end;
  1610.                   15 : begin
  1611.                         if not dstAvail(3 + tOf - sOf) then goto locEx;
  1612.                         J := MinL(maxMatchLen, 63);
  1613.                         pSmallWord(@dst[dOf])^ := 3 + (tOf - sOf) shl 2 +
  1614.                          (J shl 6) + (tOf - maxMatchPos) shl 12;
  1615.                         dst[dOf + 2] := (tOf - maxMatchPos) shr 4;
  1616.                         linearMove(src[sOf], dst[dOf + 3], tOf - sOf);
  1617.                         Register(tOf, J);
  1618.                         Inc(dOf, 3 + tOf - sOf);
  1619.                         sOf := tOf + J;
  1620.                        end;
  1621.                  end;
  1622.                 end;
  1623.           break;
  1624.          end
  1625.     else begin
  1626. skip:     Register(tOf, 1);
  1627.           Inc(tOf);
  1628.          end;
  1629.  until tOf >= srcDataSize;
  1630.  if not dstAvail(srcDataSize - sOf + 2) then goto locEx;
  1631.  while sOf < srcDataSize do
  1632.   begin
  1633.    I := MinL(srcDataSize - sOf, 63);
  1634.    if not dstAvail(succ(I)) then goto locEx;
  1635.    dst[dOf] := I shl 2;
  1636.    linearMove(src[sOf], dst[succ(dOf)], I);
  1637.    Inc(sOf, I); Inc(dOf, succ(I));
  1638.   end;
  1639.  pSmallWord(@dst[dOf])^ := 0; Inc(dOf, 2); {Put end-of-page flag}
  1640.  if dOf >= srcDataSize then goto locEx;
  1641.  PackMethod2 := _ON;
  1642.  dstDataSize := dOf;
  1643. locEx:
  1644.  FreeMem(ChainHead, (1 shl 12) * 2);
  1645.  FreeMem(Chain, srcDataSize * 2);
  1646. end;
  1647.  
  1648. procedure tLX.Pack;
  1649. const
  1650.     maxLen  : array[0..2] of Byte = (1, 16, 255);
  1651. var I,S1,S2 : Longint;
  1652.     Bf1,Bf2 : Pointer;
  1653.  
  1654. Procedure SetPage(var oD : Pointer; nD : Pointer; var oS : SmallWord; nS : Longint);
  1655. begin
  1656.  FreeMem(oD, oS); oS := nS;
  1657.  GetMem(Pages^[pred(I)], nS);
  1658.  Move(nD^, oD^, nS);
  1659. end;
  1660.  
  1661. begin
  1662.  GetMem(Bf1, Header.lxPageSize);
  1663.  GetMem(Bf2, Header.lxPageSize);
  1664.  For I := 1 to Header.lxMPages do
  1665.   with ObjMap^[I] do
  1666.    if (PageFlags = pgValid) and (PageSize > 0)
  1667.     then begin
  1668.           if @Progress <> nil then Progress(pred(I), Header.lxMPages);
  1669.           S1 := Header.lxPageSize; S2 := Header.lxPageSize;
  1670.           if (packFlags and pkfRunLength = 0) or
  1671.              (not PackMethod1(Pages^[pred(I)]^, Bf1^, PageSize, S1, maxLen[packFlags and pkfRunLengthLvl]))
  1672.            then S1 := $7FFFFFFF;
  1673.           if (packFlags and pkfLempelZiv = 0) or
  1674.              (not PackMethod2(Pages^[pred(I)]^, Bf2^, PageSize, S2))
  1675.            then S2 := $7FFFFFFF;
  1676.           if (S1 < S2) and (S1 < Header.lxPageSize) {RL-coding is effective enough?}
  1677.            then begin
  1678.                  PageFlags := pgIterData;
  1679.                  SetPage(Pages^[pred(I)], Bf1, PageSize, S1);
  1680.                 end
  1681.            else
  1682.           if (S2 < Header.lxPageSize)                  {May be LZ77 done something?}
  1683.            then begin
  1684.                  PageFlags := pgIterData2;
  1685.                  SetPage(Pages^[pred(I)], Bf2, PageSize, S2);
  1686.                 end;
  1687.          end;
  1688.  if @Progress <> nil then Progress(1, 1);
  1689.  FreeMem(Bf2, Header.lxPageSize);
  1690.  FreeMem(Bf1, Header.lxPageSize);
  1691. end;
  1692.  
  1693. procedure tLX.MinimizePage;
  1694. var dOf : Longint;
  1695.     P   : pArrOfByte;
  1696. begin
  1697.  if PageNo > Header.lxMPages then exit;
  1698.  with ObjMap^[PageNo] do
  1699.   if PageFlags = pgValid
  1700.    then begin
  1701.          dOf := PageSize;
  1702.          While (dOf > 0) and (pArrOfByte(Pages^[pred(PageNo)])^[pred(dOf)] = 0) do Dec(dOf);
  1703.          dOf := (dOf + pred(1 shl Header.lxPageShift)) and
  1704.                 ($FFFFFFFF shl Header.lxPageShift);
  1705.          if PageSize <> dOf
  1706.           then begin
  1707.                 GetMem(P, dOf);
  1708.                 Move(Pages^[pred(pageNo)]^, P^, MinL(dOf, PageSize));
  1709.                 if dOf > PageSize
  1710.                  then FillChar(P^[PageSize], dOf - PageSize, 0);
  1711.                 FreeMem(Pages^[pred(pageNo)], PageSize);
  1712.                 Pages^[pred(pageNo)] := P;
  1713.                 PageSize := dOf;
  1714.                end;
  1715.         end;
  1716. end;
  1717.  
  1718. function tLX.UsedPage;
  1719. var I : Longint;
  1720. begin
  1721.  For I := 1 to Header.lxObjCnt do
  1722.   with ObjTable^[I] do
  1723.    if (PageNo >= oPageMap) and (PageNo < oPageMap + oMapSize)
  1724.     then begin UsedPage := _ON; exit; end;
  1725.  UsedPage := _OFF;
  1726. end;
  1727.  
  1728. function tLX.isPacked;
  1729. var i,j,k,l,
  1730.     f,cp : Longint;
  1731.     pl   : pLong;
  1732.     NTR  : pNameTblRec;
  1733.     EBR  : pEntBundleRec;
  1734.     ps   : Byte;
  1735. begin
  1736.  isPacked := _OFF;
  1737.  if (newAlign <> 255) and (newAlign <> header.lxPageShift) then exit;
  1738.  if (newStubSize <> -1) and (newStubSize <> StubSize) then exit;
  1739.  if newAlign <> 255 then ps := newAlign else ps := header.lxPageShift;
  1740.  
  1741.  cp := StubSize + sizeOf(Header);
  1742.  
  1743.  if ObjTable <> nil
  1744.   then begin
  1745.         if Header.lxObjTabOfs <> cp - StubSize then exit;
  1746.         Inc(cp, Header.lxObjCnt * sizeOf(tObjTblRec));
  1747.        end;
  1748.  
  1749.  if ObjMap <> nil
  1750.   then begin
  1751.         if Header.lxObjMapOfs <> cp - StubSize then exit;
  1752.         Inc(cp, Header.lxMpages * sizeOf(tObjMapRec));
  1753.        end;
  1754.  
  1755.  if RsrcTable <> nil
  1756.   then begin
  1757.         if Header.lxRsrcTabOfs <> cp - StubSize then exit;
  1758.         Inc(cp, Header.lxRsrcCnt * sizeOf(tResource));
  1759.        end;
  1760.  
  1761.  if Header.lxResTabOfs <> cp - StubSize then exit;
  1762.  For I := 1 to ResNameTbl^.numItems do
  1763.   begin
  1764.    NTR := ResNameTbl^.GetItem(I);
  1765.    Inc(cp, succ(length(NTR^.Name^)) + sizeOf(SmallWord));
  1766.   end;
  1767.  Inc(cp);
  1768.  
  1769.  if Header.lxEntTabOfs <> cp - StubSize then exit;
  1770.  For I := 1 to EntryTbl^.numItems do
  1771.   begin
  1772.    EBR := EntryTbl^.GetItem(I);
  1773.    Inc(cp, sizeOf(EBR^.Header.Count) + sizeOf(EBR^.Header.BndType));
  1774.    if EBR^.DataSz <> 0
  1775.     then Inc(cp, sizeOf(EBR^.Header.Obj) + EBR^.DataSz);
  1776.   end;
  1777.  Inc(cp, sizeOf(EBR^.Header.Count));
  1778.  
  1779.  if ModDirTbl <> nil
  1780.   then begin
  1781.         if Header.lxDirTabOfs <> cp - StubSize then exit;
  1782.         Inc(cp, Header.lxDirCnt * sizeOf(tResource));
  1783.        end;
  1784.  
  1785.  if PerPageCRC <> nil
  1786.   then begin
  1787.         if Header.lxPageSumOfs <> cp - StubSize then exit;
  1788.         Inc(cp, Header.lxMpages * sizeOf(Longint));
  1789.        end;
  1790.  
  1791.  if Header.lxLdrSize <> cp - Header.lxObjTabOfs - StubSize then exit;
  1792.  
  1793. { Write page fixup table }
  1794.  L := cp;
  1795.  
  1796.  if Header.lxFPageTabOfs <> cp - StubSize then exit;
  1797.  Inc(cp, succ(Header.lxMpages) * sizeOf(Longint));
  1798.  
  1799.  if Header.lxFRecTabOfs <> cp - StubSize then exit;
  1800.  Inc(cp, FixRecTblSz);
  1801.  
  1802.  if Header.lxImpModOfs <> cp - StubSize then exit;
  1803.  For I := 1 to Header.lxImpModCnt do
  1804.   if ImpModTbl^.GetItem(I) <> nil
  1805.    then Inc(cp, succ(length(pString(ImpModTbl^.GetItem(I))^)))
  1806.    else Inc(cp);
  1807.  
  1808.  if Header.lxImpProcOfs <> cp - StubSize then exit;
  1809.  For I := 1 to ImpProcTbl^.numItems do
  1810.   if ImpProcTbl^.GetItem(I) <> nil
  1811.    then Inc(cp, succ(length(pString(ImpProcTbl^.GetItem(I))^)))
  1812.    else Inc(cp);
  1813.  
  1814.  if Header.lxFixupSize <> cp - L then exit;
  1815.  
  1816.  case SaveFlags and svfAlignFirstObj of
  1817.   svfFOalnNone   : ;
  1818.   svfFOalnShift  : cp := (cp + pred(1 shl ps)) and
  1819.                          ($FFFFFFFF shl ps);
  1820.   svfFOalnSector : cp := (cp + 511) and $FFFFFE00;
  1821.  end;
  1822.  if Header.lxDataPageOfs <> cp then exit;
  1823.  f := 0;
  1824.  For I := 1 to Header.lxMpages do
  1825.   begin
  1826.    K := PageOrder^[pred(I)];
  1827.    with ObjMap^[K] do
  1828.     begin
  1829.      case PageFlags of
  1830.       pgValid     : begin
  1831.                      pL := @Header.lxDataPageOfs;
  1832.                      f := f or 1;
  1833.                     end;
  1834.       pgIterData,
  1835.       pgIterData2 : begin
  1836.                      if Header.lxIterMapOfs <> Header.lxDataPageOfs then exit;
  1837.                      pL := @Header.lxIterMapOfs;
  1838.                      case PageFlags of
  1839.                       pgIterData  : f := f or 2;
  1840.                       pgIterData2 : f := f or 4;
  1841.                      end;
  1842.                     end;
  1843.       pgInvalid,
  1844.       pgZeroed    : pL := nil;
  1845.       else exit;
  1846.      end;
  1847.      if pL <> nil
  1848.       then begin
  1849.             if (Pages^[pred(K)] = nil) and (PageSize <> 0) then exit;
  1850.             L := (cp - pL^ + pred(1 shl ps)) and
  1851.                  ($FFFFFFFF shl ps);
  1852.             cp := pL^ + L;
  1853.             if PageDataOffset <> L shr ps then exit;
  1854.             Inc(cp, PageSize);
  1855.            end;
  1856.     end;
  1857.   end;
  1858.  if (f = 1) and (packFlags and (pkfRunLength or pkfLempelZiv) <> 0) then exit;
  1859.  if (f and 2 <> 0) and (packFlags and pkfRunLength = 0) then exit;
  1860.  if (f and 4 <> 0) and (packFlags and pkfLempelZiv = 0) then exit;
  1861.  
  1862.  if NResNameTbl^.numItems > 0
  1863.   then begin
  1864.         if Header.lxNResTabOfs <> cp then exit;
  1865.         For I := 1 to NResNameTbl^.numItems do
  1866.          begin
  1867.           NTR := NResNameTbl^.GetItem(I);
  1868.           Inc(cp, succ(length(NTR^.Name^)) + sizeOf(SmallWord));
  1869.          end;
  1870.         Inc(cp);
  1871.         if Header.lxCbNResTabOfs <> cp - Header.lxNResTabOfs then exit;
  1872.        end;
  1873.  
  1874.  if Header.lxDebugInfoOfs <> 0
  1875.   then if (Header.lxDebugInfoOfs <> cp) or (Header.lxDebugLen <> cp)
  1876.         then exit;
  1877.  
  1878.  isPacked := _ON;
  1879. end;
  1880.  
  1881. destructor tLX.done;
  1882. begin
  1883.  freeModule;
  1884. end;
  1885.  
  1886. end.
  1887.  
  1888.